Programalama > PASCAL

program DKA;
{---------------------------------------}
{ D.K.A. }
{ Dunyayi Kurtaran Adam }
{ Made in Turkey }
{ Bu filminVCD'leri su aralar amerikada }
{ satis rekorlari kiriyomus. }
{ }
{Bakarsin oyunu da tutar,koseyi doneriz }
{ }
{ (C) 2005 AkCr }
{ }
{ (mirage) }
{ }
{ PROGRAM KOD VE ALGORiTMALAR }
{ ORJiNAL OLUP TAMAMI iLE BANA AiTTiR }
{ ......................... }
{ ... .. ........ ...... }
{ ......... . ............. }
{ .. .. .. ..... .. }
{ ......................... }
{ Kontroller: }
{ Ates: Bosluk cubugu }
{ sol,sag tus: sola saga hareket }

{ hedef vurulunca kanat cirparak kacar }
{ kacirmadan hedefe bir kac defa daha }
{ ates edersen bonus puan alirsin }
{ }
{ SINIRSIZ SAYIDA FARKLI HEDEF VE }
{ ANIMASYONLAR YAPABiLiRSiNiZ }

{ hedefi vurmadan yere dusurmemeye calis}
{ duserse ne olur? ona sen karar ver. }
{---------------------------------------}

uses crt,Dos,graph;
const kursun:string[3]='I'; {kursun sekli}
maxdusman=5;{Dusman sayisi}
maxisabet:byte=8;{Ayni Hedefe kac defa isabet ederse bonus puan alinacagi}
maxmermi:byte=10;{Tetige basilitut arka arkaya 10 mermi otomatik atar}
{Tek tek atis icin maxmermi:=1 yap 50 yi gecme}

dusmantip:string[11]='<<>>';{DUSMAN sekli}{ isim de yazabilirsiniz. >:-)) }

animetip:array[1..2] of string[11]=('/\/\','\/\/');{animasyon karakterleri}
Skor:longint=0;
seviye:byte=1;

type Tmermi=record
x,y:integer;
end;
Tsilah=record
x,y:integer;
p:pointer;
size:word;
end;
Tdusman=Record
x,y:integer;
renk,hiz:byte;
tip:string[11];
vuruldu:boolean;
isabet:byte; {bu hedefe kac mermi isabet ettigi}
sure:integer;{kanat cirpma animasyonu icin gecis suresi}
puan:byte; {bu hedefin maximum puan degeri}
end;
Tskorbord=Record
x,y,en,boy:integer;
end;

var mermi:array[1..50] of tmermi;
msay,i:integer;
dusman:array[1..maxdusman] of tdusman;
tus:char;
silah:Tsilah;
Kapat:Boolean;
skorbord:Tskorbord;


procedure DusmanTanimla;
begin

for i:=1 to maxdusman do {Dusmanlar tanimlaniyor}
with dusman[i] do
begin
x:=Random(580)+20;
y:=1;
renk:=random(15)+1;
hiz:=Random(5)+1;
tip:=Dusmantip;
puan:=renk*10;
end;
end;

procedure KlavyeBufSil;
begin
mem[$0040:$001a] := mem[$0040:$001c];
end;

procedure bekle(sure:integer);
var st,dk,sn,sl,sn2:word;
say:integer;
begin
gettime(st,dk,sn,sl);
say:=0;
repeat
gettime(st,dk,sn2,sl);
if sn2<>sn then begin inc(say);sn:=sn2;end;
until say=sure;
klavyebufsil;
end;

procedure skoryaz;
begin
with skorbord do
begin
setfillstyle(1,0);
bar(x+2,y+2,x+en-2,y+boy-2);
setcolor(8);
settextstyle(3,0,1);
outtextxy(x+((en-textwidth(inttostr(skor))) div 2),y+((boy-textheight('8')) div 2)-3,inttostr(skor));
settextstyle(0,0,0);
end;
end;

procedure kutu(x,y,en,boy:integer;renk:byte);
begin
setfillstyle(1,7);
bar(x,y,x+en,y+boy);
setcolor(0);
moveto(x+en,y);
lineto(x,y);
lineto(x,y+boy);
setcolor(15);
lineto(x+en,y+boy);
lineto(x+en,y);
setfillstyle(1,renk);
bar(x+2,y+2,x+en-2,y+boy-2);
end;

procedure seviyeyaz;{kontrol panele}
begin
kutu(20,440,40,30,0);
settextstyle(1,0,2);
setcolor(7);
outtextxy(22+((40-textwidth(inttostr(seviye))) div 2),436+((30-textheight('8')) div 2),inttostr(seviye));
settextstyle(0,0,0);
end;

procedure kontrolpanel;
begin
setfillstyle(9,4);
bar(0,425,639,475);
setcolor(12);
line(0,425,639,425);

with skorbord do
begin
x:=280;
y:=440;
en:=100;
boy:=30;
kutu(x,y,en,boy,0);{skor gostergesi}
setfillstyle(1,4);
bar(x+30,y-11,x+72,y-3);{skor baslik}
bar(16,y-11,20+48,y-3);{seviye baslik}
setcolor(7);
outtextxy(x+35,y-10,'SKOR');
outtextxy(18,y-10,'SEViYE');
{--- seviye ----}
kutu(20,y,40,30,0);{seviye gostergesi}
kutu(440,y,180,20,8);{mesaj kutusu}
setcolor(0);
outtextxy(445,y+7,'istilacilari durdur..');
end;
Skoryaz;
end;

procedure ses;
var s:integer;
begin
for s:=1 to 10 do
begin
sound(5000-(i*500));
delay(10);
end;
nosound;
end;

procedure seviyegoster;{kacinci seviye oldugu gosteriliyor}
var i:integer;
begin
setrgbpalette(2,0,0,0);
setcolor(2);
settextstyle(1,0,3);
outtextxy(270,140,'BOLUM');
outtextxy(300,165,inttostr(seviye));
for i:=1 to 45 do {renk aciliyor}
begin
setrgbpalette(2,i,i,i);
delay(500);
if keypressed then klavyebufsil;
end;
bekle(2);
for i:=45 downto 0 do {renk karariyor}
begin
setrgbpalette(2,i,i,i);
if keypressed then klavyebufsil;
delay(400);
end;
setcolor(0);
outtextxy(270,140,'BOLUM');
outtextxy(300,165,inttostr(seviye));
setrgbpalette(2,0,40,0);
settextstyle(0,0,0);
klavyebufsil;
end;

procedure seviyekontrol;
{Seviye gecmek icin gerekli kriterleri buradan kontrol edin}
{Seviye gecildi ise gerekli ayarlar yapilarak
ekran bir sonraki seviyeye hazilanacak }
begin
case seviye of
1:begin
{if (bu seviyeyi gecmek icin gerekli kriterlere ulasildi) then }
{begin}
{inc(seviye)}
{Dusmantip:='==<^>=='}
{animetip[1]:='< ^ >';animetip[2]:=' <^>'}
{maxisabet:=12}
{maxmermi:=5}
{seviyegoster;}

{vs..vs..vs..}
{gibi..}

{end;}
end;
2:begin
{dusmantip:='()'}
{animetip[1]:='(* )';animetip[2]:='( *)'}
end;
3:begin
{dusmantip:='DUSMAN'}
{animetip[1]:=' DUSMAN',animetip[2]:='D U S M A N'}
end;
end;
end;

procedure mermiyap;{Silahtan cikan her mermi sayiliyor ve tanimlaniyor}
begin
inc(msay);
if msay>maxmermi then msay:=maxmermi else
with mermi[msay] do
begin
x:=silah.x;
y:=silah.y-7;
setcolor(12);
outtextxy(x,y,kursun);
end;
end;

procedure ateset;
var j,d:integer;
begin
for i:=1 to msay do {Silahtan cikan her mermi bir hedefi vurup vurmadigi,
hangi hedefi vurdugu,ileri yondeki hareketi,
menzil disina cikip cikmadigi tek tek kontrol ediliyor
}
with mermi[i] do
begin
setcolor(0);
outtextxy(x,y,kursun);
dec(y,10);
if y<0 then
begin {mermi ekran disina ciktiysa bu mermi siliniyor,digerleri yoluna devam}
for j:=i to msay-1 do mermi[j]:=mermi[j+1];
dec(msay);
if (i=msay) then begin msay:=1;end;
end;
for d:=1 to maxdusman do {Hedefin vurulup vurulmadigi kontrol ediliyor}
begin
if (x>dusman[d].x-3) and (x<dusman[d].x+textwidth(dusman[d].tip)) and
(y>dusman[d].y-8) and (y<dusman[d].y+8) and (dusman[d].isabet<maxisabet)then
with dusman[d] do
begin
vuruldu:=True;
inc(isabet);
inc(skor,5);
hiz:=1;
setcolor(0);
outtextxy(x,y,tip);
if isabet=maxisabet then
begin
tip:=inttostr(puan);
skor:=skor+puan;
end else tip:=animetip[1];
y:=Y-6;
ses;
skoryaz;
seviyekontrol;
end;
end;
setcolor(12);
outtextxy(x,y,kursun);
end;
end;


procedure solakay;{silahimizi sola kaydirir}
begin
with silah do
begin
setcolor(0);
setfillstyle(1,0);
bar(x-8,y,x+20,y+20);
dec(x,14);if x<8 then x:=8;
putimage(x-8,y,P^,normalput);
end;
end;

procedure sagakay;{silahimizi saga kaydirir}
begin
with silah do
begin
setcolor(0);
setfillstyle(1,0);
bar(x-8,y,x+20,y+20);
inc(x,14);if x>620 then x:=620;
putimage(x-8,y,P^,normalput);
end;
end;

procedure dusmanciz(d:Tdusman);
begin
with d do begin
setcolor(renk);
outtextxy(x,y,tip);
end;
end;

Procedure dusmansil(d:tdusman);
begin
with d do begin
setcolor(0);
outtextxy(x,y,tip);
end;
end;

procedure dusmangel;{Dusman yukardan asagi iniyor}
var a:integer;
begin
for a:=1 to maxdusman do
with dusman[a] do
begin
dusmansil(dusman[a]);
inc(y,hiz);
if y>412 then
begin
y:=0;
x:=random(580)+20;
hiz:=Random(5)+1;
renk:=random(15)+1;
puan:=renk*10;
tip:=Dusmantip;
vuruldu:=false;
isabet:=0;
end;
if vuruldu and (isabet<maxisabet)then
begin {bu hedef vuruldu ise kanat cirpma hareketi ciziliyor}
inc(sure);
if sure>15 then
begin
if tip=animetip[1] then tip:=animetip[2] else tip:=animetip[1];
sure:=0;
end;
if x>320 then inc(x,hiz) else dec(x,hiz);{saga veya sola kayarak ucuyor}
end;{if vuruldu}
dusmanciz(dusman[a]);
end;
end;

procedure silahyap;{silah resmi ciziliyor}
begin
with silah do
begin
setfillstyle(9,9);
bar(0,10,20,20);
setfillstyle(9,1);
setcolor(1);
pieslice(10,10,0,360,8);
setfillstyle(1,12);
bar(8,0,12,10);
setcolor(7);
line(4,8,16,8);
line(4,6,16,6);
line(4,4,16,4);
line(6,2,14,2);
size:=imagesize(0,0,20,20);
getmem(P,size);
getimage(0,0,20,20,P^);
x:=320;
y:=400;
end;
Cleardevice;
end;

procedure GrafAc;
var
gD: Integer;
gM: Integer;
begin
gD := Detect;
InitGraph(gD,gM,'C:\tp\bgi');
end;

procedure AcilisEkrani;
var i,r,g,b:integer;
begin
setrgbpalette(60,0,0,0);
settextstyle(1,0,7);
SETCOLOR(12);
outtextxy(210,100,'D.K.A');
settextstyle(0,0,0);
OUTTEXTXY(200,180,'DUNYAYI KURTARAN ADAM');
For i:=1 to 63 do
begin
setrgbpalette(60,i,0,0);
delay(400);
end;
bekle(3);
For i:=63 downto 1 do
begin
setrgbpalette(60,i,0,0);
delay(400);
end;

end;

Begin
Randomize;
GrafAc;
setrgbpalette(56,50,30,20);{turuncu oldu, 8 nolu rengi degistirdim}
AcilisEkrani;
cleardevice;
setrgbpalette(60,63,10,10);{kirmizi, dogal rengi ayarlaniyor}
silahyap;
kontrolpanel;
Dusmantanimla;
Kapat:=False;
sagakay;
seviyeyaz;
seviyegoster;
repeat
if keypressed then
begin
tus:=readkey;
case tus of
#0:begin
tus:=readkey;
case tus of
#75:solakay;
#77:sagakay;
end;
end;
#32:mermiyap;{Bosluk tusuna basildi ise mermi uretiliyor}
#27:Kapat:=True;
end;
end;
ateset;
dusmangel;
delay(200);{oyunu yavaslatmak icin degerini artir, tersi icin azalt}
until kapat;
CloseGraph;
End.



cilgin paskalci
turbopaskal_664@box.az